ruta_totales <- "C:\\Users\\Usuario\\Downloads\\ARCHIVOS DE POSIT\\TOTALES_2025.xlsx"
#"/cloud/project/TOTALES_2025.xlsx"
excel_sheets(ruta_totales)
## [1] "Plan1"
Totales2025 <- as.data.frame(read_xlsx(ruta_totales, sheet = "Plan1"))
Totales2025$Semana <- format(Totales2025$Fecha, format ="%Y-%U")
Fecha2025 <- Totales2025$Fecha
Totales2025 <- Totales2025 %>%
group_by(Semana = as.character(Semana)) %>%
summarize(Totales = sum(Totales),
.groups = "keep")
head(Totales2025)
## # A tibble: 6 × 2
## # Groups: Semana [6]
## Semana Totales
## <chr> <dbl>
## 1 2024-48 2926.
## 2 2025-00 2466.
## 3 2025-01 204571.
## 4 2025-02 278470.
## 5 2025-03 82224.
## 6 2025-04 40008.
tail(Totales2025)
## # A tibble: 6 × 2
## # Groups: Semana [6]
## Semana Totales
## <chr> <dbl>
## 1 2025-08 125620.
## 2 2025-09 363558.
## 3 2025-11 43291.
## 4 2025-13 412042.
## 5 2025-14 4749.
## 6 2025-15 923.
nrow(Totales2025)
## [1] 15
totales_2025_ts <- ts(Totales2025$Totales,start =1, frequency =1)
totales_2025_xts <- as.xts(totales_2025_ts)
ruta <- "C:\\Users\\Usuario\\Downloads\\ARCHIVOS DE POSIT\\Ventas_Suministros_Totales.xlsx"
excel_sheets(ruta)
## [1] "Ventas Totales Original" "Servicios Totales Original"
# "Ventas Totales Original" "Servicios Totales Original"
Productos_Totales <- as.data.frame(read_xlsx(ruta,
sheet = "Ventas Totales Original"))
Productos_Totales$Semana <- format(Productos_Totales$Fecha, format = "%Y-%U")
Productos_Totales$mes <- format(Productos_Totales$Fecha, format = "%Y-%m")
head(Productos_Totales)
## Folio Fecha RFC Empresa
## 1 1 2019-07-01 10:01:03 VEPS740807T84 Silvia Elena Velasco Palacios
## 2 2 2019-07-01 11:40:32 CERI890615EU1 ISRAEL CETINA ROSALES
## 3 2 2019-07-01 11:40:32 CERI890615EU1 ISRAEL CETINA ROSALES
## 4 2 2019-07-01 11:40:32 CERI890615EU1 ISRAEL CETINA ROSALES
## 5 2 2019-07-01 11:40:32 CERI890615EU1 ISRAEL CETINA ROSALES
## 6 2 2019-07-01 11:40:32 CERI890615EU1 ISRAEL CETINA ROSALES
## Cantidad Unidad
## 1 1 Bidón de plástico
## 2 1 Pieza
## 3 1 Pieza
## 4 1 Pieza
## 5 1 Pieza
## 6 1 Pieza
## Descripcion ValorUnitario
## 1 Algicin marca Spin en presentación de garrafa de 20 Litros 700.00
## 2 Kit de Sello y espaciadores Piston Superior 308.04
## 3 Kit de sello y espaciadores Piston Inferior 811.78
## 4 Kit Piston Superior 9000/9100 968.58
## 5 Kit Piston Inferior 9000/9100 1784.38
## 6 Engrane motriz Inferior 9100 1092.00
## Total Semana mes
## 1 812.0000 2019-26 2019-07
## 2 357.3264 2019-26 2019-07
## 3 941.6648 2019-26 2019-07
## 4 1123.5528 2019-26 2019-07
## 5 2069.8808 2019-26 2019-07
## 6 1266.7200 2019-26 2019-07
nrow(Productos_Totales)
## [1] 1995
productos <- data.frame(Fecha = Productos_Totales$Fecha, Totales = Productos_Totales$Total)
Servicios_Totales <- as.data.frame(read_xlsx(ruta,
sheet = "Ventas Totales Original"))
Servicios_Totales$Semana <- format(Servicios_Totales$Fecha, format = "%Y-%U")
Servicios_Totales$mes <- format(Servicios_Totales$Fecha, format = "%Y-%m")
head(Servicios_Totales)
## Folio Fecha RFC Empresa
## 1 1 2019-07-01 10:01:03 VEPS740807T84 Silvia Elena Velasco Palacios
## 2 2 2019-07-01 11:40:32 CERI890615EU1 ISRAEL CETINA ROSALES
## 3 2 2019-07-01 11:40:32 CERI890615EU1 ISRAEL CETINA ROSALES
## 4 2 2019-07-01 11:40:32 CERI890615EU1 ISRAEL CETINA ROSALES
## 5 2 2019-07-01 11:40:32 CERI890615EU1 ISRAEL CETINA ROSALES
## 6 2 2019-07-01 11:40:32 CERI890615EU1 ISRAEL CETINA ROSALES
## Cantidad Unidad
## 1 1 Bidón de plástico
## 2 1 Pieza
## 3 1 Pieza
## 4 1 Pieza
## 5 1 Pieza
## 6 1 Pieza
## Descripcion ValorUnitario
## 1 Algicin marca Spin en presentación de garrafa de 20 Litros 700.00
## 2 Kit de Sello y espaciadores Piston Superior 308.04
## 3 Kit de sello y espaciadores Piston Inferior 811.78
## 4 Kit Piston Superior 9000/9100 968.58
## 5 Kit Piston Inferior 9000/9100 1784.38
## 6 Engrane motriz Inferior 9100 1092.00
## Total Semana mes
## 1 812.0000 2019-26 2019-07
## 2 357.3264 2019-26 2019-07
## 3 941.6648 2019-26 2019-07
## 4 1123.5528 2019-26 2019-07
## 5 2069.8808 2019-26 2019-07
## 6 1266.7200 2019-26 2019-07
nrow(Servicios_Totales)
## [1] 1995
servicios <- data.frame(Fecha = Servicios_Totales$Fecha, Totales = Servicios_Totales$Total)
Totales <- merge(x = productos, servicios, all = T)
Totales$Semana <- format(Totales$Fecha, format = "%Y-%U")
Totales2019 <- Totales %>%
group_by(Semana = as.character(Semana)) %>%
summarize(Totales = sum(Totales),
.groups = "keep")
head(Totales2019)
## # A tibble: 6 × 2
## # Groups: Semana [6]
## Semana Totales
## <chr> <dbl>
## 1 2019-26 55401.
## 2 2019-27 27527.
## 3 2019-28 16138.
## 4 2019-29 48245.
## 5 2019-30 7175.
## 6 2019-31 31157.
tail(Totales2019)
## # A tibble: 6 × 2
## # Groups: Semana [6]
## Semana Totales
## <chr> <dbl>
## 1 2024-20 27773.
## 2 2024-22 30244.
## 3 2024-24 44905.
## 4 2024-25 6206
## 5 2024-27 4988
## 6 2024-29 3828
nrow(Totales2019)
## [1] 242
Totales2019_ts <- ts(Totales2019$Totales, start = 1, frequency = 1)
LAMT <- boxcox(x = as.numeric(Totales2019_ts), objective.name = "Log-Likelihood", optimize = T)
LAMT$lambda
## [1] 0.1723989
# [1] 0.1723989
Totales2019Semana <- boxcoxTransform(x = as.numeric(Totales2019_ts), lambda = LAMT$lambda )
head(Totales2019Semana)
## [1] 32.32742 27.99620 25.02391 31.42908 21.00369 28.72566
tail(Totales2019Semana)
## [1] 28.04819 28.54908 30.97142 20.34169 19.37533 18.25231
length(Totales2019Semana)
## [1] 242
serie_sem_tot <- ts(Totales2019Semana, start = 1, frequency = 1)
# entrenamiento
ggAcf(serie_sem_tot, lag.max = 52, col = "red", lwd = 2)
ggPacf(serie_sem_tot, lag.max = 52, col = "blue", lwd = 2)
spec_sem_GARCH_11 <- ugarchspec(variance.model = list(model = "sGARCH",
garchOrder = c(1, 1)),
mean.model = list(armaOrder = c(32, 29)),
distribution.model = "std")
aju_GARCH_11 <- ugarchfit(data = serie_sem_tot,
spec = spec_sem_GARCH_11)
## Warning in arima(data, order = c(modelinc[2], 0, modelinc[3]), include.mean =
## modelinc[1], : possible convergence problem: optim gave code = 1
spec_sem_GARCH_21 <- ugarchspec(variance.model = list(model = "sGARCH",
garchOrder = c(2, 1)),
mean.model = list(armaOrder = c(32, 29)),
distribution.model = "std")
aju_GARCH_21 <- ugarchfit(data = serie_sem_tot,
spec = spec_sem_GARCH_21)
## Warning in arima(data, order = c(modelinc[2], 0, modelinc[3]), include.mean =
## modelinc[1], : possible convergence problem: optim gave code = 1
spec_sem_GARCH_12 <- ugarchspec(variance.model = list(model = "sGARCH",
garchOrder = c(1, 2)),
mean.model = list(armaOrder = c(32, 29)),
distribution.model = "std")
aju_GARCH_12 <- ugarchfit(data = serie_sem_tot,
spec = spec_sem_GARCH_12)
## Warning in arima(data, order = c(modelinc[2], 0, modelinc[3]), include.mean =
## modelinc[1], : possible convergence problem: optim gave code = 1
spec_sem_GARCH_22 <- ugarchspec(variance.model = list(model = "sGARCH",
garchOrder = c(2, 2)),
mean.model = list(armaOrder = c(32, 29)),
distribution.model = "std")
aju_GARCH_22 <- ugarchfit(data = serie_sem_tot,
spec = spec_sem_GARCH_22)
## Warning in arima(data, order = c(modelinc[2], 0, modelinc[3]), include.mean =
## modelinc[1], : possible convergence problem: optim gave code = 1
infocriteria(aju_GARCH_11)
##
## Akaike 6.682725
## Bayes 7.634253
## Shibata 6.572588
## Hannan-Quinn 7.066035
infocriteria(aju_GARCH_21)
##
## Akaike 6.641553
## Bayes 7.607498
## Shibata 6.528485
## Hannan-Quinn 7.030670
infocriteria(aju_GARCH_12)
##
## Akaike 6.686557
## Bayes 7.652503
## Shibata 6.573489
## Hannan-Quinn 7.075675
infocriteria(aju_GARCH_22)
##
## Akaike 6.634561
## Bayes 7.614924
## Shibata 6.518534
## Hannan-Quinn 7.029487
Con el conjunto de prueba de los totales diarios se realiza los pronósticos.
pronostico_garch22 <- ugarchforecast(fitORspec = aju_GARCH_22,
n.ahead = length(totales_2025_ts))
volatilidad_pronosticada <- pronostico_garch22@forecast$sigmaFor
serie_pronosticada <- pronostico_garch22@forecast$seriesFor
length(serie_pronosticada)
## [1] 15
residuales <- residuals(aju_GARCH_22)
# objeto xts
residuales_df <- data.frame(Residuales = coredata(residuales))
head(residuales_df)
## Residuales
## 1 2.052286
## 2 -2.278933
## 3 -5.251220
## 4 1.153946
## 5 -9.271447
## 6 -1.549471
errores_semana <- residuales_df
sd_errores_semana <- sd(errores_semana$Residuales, na.rm =T)
margen_erro_semana <- sd_errores_semana * qnorm(0.9)# 90%
margen_erro_semana2 <- sd_errores_semana * qnorm(0.975)# 95%
prediccion <- data.frame(pronosticos = as.numeric(pronostico_garch22@forecast$seriesFor),
actuales = as.numeric(totales_2025_ts))
prediccion$inf <- prediccion$pronosticos - margen_erro_semana
prediccion$sup <- prediccion$pronosticos + margen_erro_semana
prediccion$inferior <- prediccion$pronosticos - margen_erro_semana2
prediccion$superior <- prediccion$pronosticos + margen_erro_semana2
head(prediccion)
## pronosticos actuales inf sup inferior superior
## 1 23.16797 2925.52 15.19249 31.14345 10.97052 35.36541
## 2 32.24078 2466.16 24.26530 40.21626 20.04333 44.43823
## 3 30.94365 204571.37 22.96817 38.91914 18.74621 43.14110
## 4 32.82931 278469.60 24.85383 40.80479 20.63186 45.02675
## 5 23.41481 82223.67 15.43933 31.39029 11.21736 35.61225
## 6 37.19336 40008.40 29.21788 45.16884 24.99591 49.39080
tail(prediccion)
## pronosticos actuales inf sup inferior superior
## 10 39.28439 125620.09 31.30891 47.25987 27.08694 51.48183
## 11 29.61150 363557.63 21.63602 37.58699 17.41406 41.80895
## 12 29.15349 43291.20 21.17801 37.12897 16.95604 41.35093
## 13 40.73056 412041.51 32.75508 48.70604 28.53312 52.92801
## 14 27.14545 4749.04 19.16997 35.12093 14.94800 39.34289
## 15 28.55654 923.36 20.58106 36.53202 16.35910 40.75399
nrow(prediccion)
## [1] 15
prediccion
## pronosticos actuales inf sup inferior superior
## 1 23.16797 2925.52 15.19249 31.14345 10.97052 35.36541
## 2 32.24078 2466.16 24.26530 40.21626 20.04333 44.43823
## 3 30.94365 204571.37 22.96817 38.91914 18.74621 43.14110
## 4 32.82931 278469.60 24.85383 40.80479 20.63186 45.02675
## 5 23.41481 82223.67 15.43933 31.39029 11.21736 35.61225
## 6 37.19336 40008.40 29.21788 45.16884 24.99591 49.39080
## 7 42.55636 97084.26 34.58088 50.53184 30.35892 54.75381
## 8 42.49367 418748.40 34.51819 50.46915 30.29622 54.69111
## 9 34.87741 380503.13 26.90193 42.85289 22.67997 47.07486
## 10 39.28439 125620.09 31.30891 47.25987 27.08694 51.48183
## 11 29.61150 363557.63 21.63602 37.58699 17.41406 41.80895
## 12 29.15349 43291.20 21.17801 37.12897 16.95604 41.35093
## 13 40.73056 412041.51 32.75508 48.70604 28.53312 52.92801
## 14 27.14545 4749.04 19.16997 35.12093 14.94800 39.34289
## 15 28.55654 923.36 20.58106 36.53202 16.35910 40.75399
actuales_trans <- boxcoxTransform(x = as.numeric(totales_2025_ts), lambda = 0.1723989)
actuales_trans
## [1] 17.16284 16.49649 41.95785 44.56570 35.01316 30.24668 36.19903 48.23561
## [9] 47.35071 38.10690 46.93490 30.74010 48.08540 19.16316 13.02265
prediccion$actuales_trans <- actuales_trans
prediccion
## pronosticos actuales inf sup inferior superior actuales_trans
## 1 23.16797 2925.52 15.19249 31.14345 10.97052 35.36541 17.16284
## 2 32.24078 2466.16 24.26530 40.21626 20.04333 44.43823 16.49649
## 3 30.94365 204571.37 22.96817 38.91914 18.74621 43.14110 41.95785
## 4 32.82931 278469.60 24.85383 40.80479 20.63186 45.02675 44.56570
## 5 23.41481 82223.67 15.43933 31.39029 11.21736 35.61225 35.01316
## 6 37.19336 40008.40 29.21788 45.16884 24.99591 49.39080 30.24668
## 7 42.55636 97084.26 34.58088 50.53184 30.35892 54.75381 36.19903
## 8 42.49367 418748.40 34.51819 50.46915 30.29622 54.69111 48.23561
## 9 34.87741 380503.13 26.90193 42.85289 22.67997 47.07486 47.35071
## 10 39.28439 125620.09 31.30891 47.25987 27.08694 51.48183 38.10690
## 11 29.61150 363557.63 21.63602 37.58699 17.41406 41.80895 46.93490
## 12 29.15349 43291.20 21.17801 37.12897 16.95604 41.35093 30.74010
## 13 40.73056 412041.51 32.75508 48.70604 28.53312 52.92801 48.08540
## 14 27.14545 4749.04 19.16997 35.12093 14.94800 39.34289 19.16316
## 15 28.55654 923.36 20.58106 36.53202 16.35910 40.75399 13.02265
checkresiduals(residuales_df$Residuales, col = "darkgreen")
##
## Ljung-Box test
##
## data: Residuals
## Q* = 21.15, df = 10, p-value = 0.02007
##
## Model df: 0. Total lags used: 10
# p-value = 0.02007
accuracy(prediccion$pronosticos, prediccion$actuales_trans)
## ME RMSE MAE MPE MAPE
## Test set 1.272128 10.38545 9.238408 -10.24416 34.42067
valores_reales <- InvBoxCox(x = prediccion, lambda = 0.1723989)
valores_reales$actuales <- NULL
valores_reales
## pronosticos inf sup inferior superior actuales_trans
## 1 11256.88 1738.644 46137.52 472.6902 86426.23 2925.52
## 2 54675.03 13966.260 164916.40 5806.2478 274406.14 2466.16
## 3 44708.87 10813.932 139712.23 4307.0018 235774.88 204571.37
## 4 59767.27 15628.407 177532.43 6616.3549 293584.35 278469.60
## 5 11824.77 1860.622 47954.53 514.4975 89475.80 82223.67
## 6 111197.01 33822.686 298376.85 16053.2873 473412.82 40008.40
## 7 219896.62 77298.854 533077.13 40736.3810 810684.19 97084.26
## 8 218248.08 76605.327 529645.02 40328.3966 805827.76 418748.40
## 9 80649.96 22742.632 227834.29 10200.4562 369190.28 380503.13
## 10 146462.40 47349.056 376746.60 23499.1609 587379.16 125620.09
## 11 36088.33 8213.854 117233.57 3116.1080 200899.36 363557.63
## 12 33463.55 7449.696 110234.54 2775.9656 189944.42 43291.20
## 13 175898.61 59104.204 440341.61 30162.0236 678778.14 412041.51
## 14 23742.68 4756.555 83491.04 1624.4292 147568.28 4749.04
## 15 30281.58 6542.933 101634.85 2379.3065 176412.86 923.36